home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / twu1.zip / TWU1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-06-06  |  53KB  |  1,657 lines
  1. {$D-,L-,S+,R-,E-,N-}
  2. PROGRAM TWU1B;
  3. Uses TWU1EQU, TWU1UAM, TWU1RPT, TWU1UNA, Dos, Crt;
  4.  
  5. TYPE
  6.    MethodName    = String[127];
  7.    HeadProc    = PROCEDURE;
  8.    LGClass   = (
  9.            LG_ABSQ,        {Absolute Equivalence}
  10.                 LG_ARBC,        {Array Bounds}
  11.                 LG_ASGN,        {Biggest Assgn Compat Type}
  12.                 LG_BASE,        {Base Type}
  13.                LG_CONS,        {Const Type}
  14.                 LG_FUNR,        {Function Result}
  15.                 LG_OBJP,        {Parent Object}
  16.                 LG_PARM,        {Formal Parameter}
  17.                 LG_TYPE            {Named Type, Xtrn Var}
  18.                 );
  19.    LGString    = String[21];
  20.  
  21. VAR
  22.    NoteTime,    JobTime:    LongInt;    { Elapsed Time Buckets    }
  23.    NextLL,    LastLL:        LongInt;    { Location Counters    }
  24.    OffsetLL:            LongInt;    { Section Relative Base }
  25.    TabStop,    NoteX,    NoteY:    Integer;    { Miscellaneous        }
  26.    CPUType:    CPUGate;            { Optional Parameter    }
  27.    DisAssembly: Boolean;            { Optional Parameter    }
  28.    SurveyWork:     SurveyRec;            { Common Work Variable    }
  29.    Map,MapC:     MapRefRec;            { Common Work Variables }
  30.    Win:     Boolean;            { WINDOWS Option    }
  31.  
  32. CONST
  33.    TypTxt : Array[0..15] of String[11] = (
  34.        { $0} 'untyped', { $1} 'ARRAY', { $2} 'RECORD',    { $3} 'OBJECT',
  35.         { $4} 'FILE',     { $5} 'TEXT',  { $6} 'proc',    { $7} 'SET',
  36.         { $8} 'POINTER', { $9} 'STRING',{ $A} '8087 float',
  37.     { $B} '6-byte real',        { $C} 'fixed-point',
  38.     { $D} 'boolean', { $E} 'char',    { $F} 'enumeration');
  39.  
  40. PROCEDURE NoteBegin(S:String);                    {.CP08}
  41. VAR HH,MM,SS,CS : Word;
  42. BEGIN
  43.     NoteX := WhereX; NoteY := WhereY; ClrEol;
  44.     GetTime(HH,MM,SS,CS);
  45.     NoteTime := (LongInt(HH*60+MM)*60+SS)*100+CS;
  46.     If S <> '' Then Write(S);
  47. END;
  48.  
  49. PROCEDURE PageOverFlow(Lines : Word; CallProc : HeadProc);    {.CP09}
  50. BEGIN
  51.     IF LinesRemaining < Lines THEN
  52.     BEGIN
  53.         NewTxtPage;
  54.         CallProc;
  55.     END
  56.     ELSE    NewTxtLine;
  57. END;
  58.  
  59. PROCEDURE NoteEnd;                        {.CP11}
  60. VAR HH,MM,SS,CS : Word; SF : String[3];  I : Integer;
  61. BEGIN
  62.     GetTime(HH,MM,SS,CS);
  63.     NoteTime := ((LongInt(HH*60+MM)*60+SS)*100+CS) - JobTime;
  64.         Str(NoteTime MOD 100 + 100:3,SF);
  65.         I := NoteTime DIV 100;
  66.         GoToXY(NoteX,NoteY+1);
  67.         ClrEol;
  68.     Write('Elapsed Time: ',I,'.',Copy(SF,2,2),' seconds');
  69.     GoToXY(NoteX,NoteY);
  70. END;
  71.  
  72. FUNCTION NameOfMethod(U:UnitPtr;UsrDE:LL):MethodName;        {.CP20}
  73. VAR DS, DC : DNamePtr; S : DStubPtr; T : TypePtr; N, M : String[64];
  74. BEGIN
  75.     N := ''; M := '???';
  76.     IF UsrDE <> $FFFF THEN
  77.     BEGIN
  78.        DS := DNamePtr(PtrAdjust(U,UsrDE));
  79.        M  := DS^.DSymb;
  80.        S  := AddrStub(DS);
  81.        IF Public(DS^.DForm) = 'S' THEN {ensure subprogram entry}
  82.        IF (S^.sSTp AND $10) <> 0  THEN {get OBJECT Name Qualifier}
  83.        IF  S^.sSPS <> 0 THEN
  84.        BEGIN
  85.         T  := TypePtr(PtrAdjust(U,S^.sSPS));      {to Object TD}
  86.         DC := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  87.         N  := DC^.Dsymb+'.';
  88.        END
  89.     END;
  90.     NameOfMethod := N + M
  91. END;   {NameOfMethod}
  92.  
  93. PROCEDURE PrintTitleBlk(S : String; LinesNeeded : Integer);    {.CP08}
  94. BEGIN {PrintTitleBlk}
  95.     IF LinesRemaining < LinesNeeded+3
  96.         THEN NewTxtPage    ELSE SetCol(1);
  97.     PutTxt('-----');   NewTxtLine;
  98.     PutTxt('- ' + S); NewTxtLine;
  99.     PutTxt('-----');   SetCol(1);
  100. END; {PrintTitleBlk}
  101.  
  102. PROCEDURE PrintAddress(Arg : LongInt);                {.CP06}
  103. BEGIN
  104.     IF ColumnsUsed <> 0 THEN NewTxtLine;
  105.     PutTxt(HexA(Arg));
  106.     SetCol(7);
  107. END; {PrintAddress}
  108.  
  109. PROCEDURE PrintByteList(U : Pointer; Count, Space : Word);    {.CP10}
  110. BEGIN
  111.     WHILE Count > 0 DO
  112.     BEGIN
  113.         PutTxt(HexB(Mem[Seg(U^):Ofs(U^)+NextLL-OffsetLL]));
  114.         SetCol(ColumnsUsed+Space+1);
  115.         Inc(NextLL);
  116.         Dec(Count);
  117.     END
  118. END; {PrintByteList}
  119.  
  120. PROCEDURE PrintWd(U : UnitPtr; S : String);            {.CP07}
  121. BEGIN
  122.     PrintAddress(NextLL);
  123.     PrintByteList(U,2,1);
  124.     SetCol(TabStop);
  125.     PutTxt(S);
  126. END; {PrintWd}
  127.  
  128. PROCEDURE PrintDWd(U : UnitPtr; S : String);            {.CP07}
  129. BEGIN
  130.     PrintAddress(NextLL);
  131.     PrintByteList(U,4,1);
  132.     SetCol(TabStop);
  133.     PutTxt(S);
  134. END; {PrintDWd}
  135.  
  136. PROCEDURE PrintLL(U : UnitPtr; S : String);            {.CP07}
  137. BEGIN
  138.     PrintAddress(NextLL);
  139.     PrintByteList(U,2,1);
  140.     SetCol(TabStop);
  141.     PutTxt('LL('+S+')');
  142. END; {PrintLL}
  143.  
  144. PROCEDURE PrintSoloByte(U : UnitPtr; S : String);        {.CP08}
  145. VAR B : Byte;
  146. BEGIN
  147.     PrintAddress(NextLL);
  148.     PrintByteList(U,1,0);
  149.     SetCol(TabStop);
  150.     PutTxt(S);
  151. END; {PrintSoloByte}
  152.  
  153. PROCEDURE PrintBytes(U : UnitPtr; Count, Limit : Word);        {.CP12}
  154. VAR I : Integer;
  155. BEGIN
  156.     I := 0;
  157.     WHILE Count > 0 DO BEGIN
  158.         I := I MOD Limit;
  159.         IF I = 0 THEN PrintAddress(NextLL);
  160.         PrintByteList(U,1,1);
  161.         Inc(I);
  162.         Dec(Count);
  163.     END;
  164. END; {PrintBytes}
  165.  
  166. PROCEDURE PrintBytesOff(U: UnitPtr; Cnt, Lim, Indent : Word);    {.CP16}
  167. VAR I : Integer;
  168. BEGIN
  169.     I := 0;
  170.     WHILE Cnt > 0 DO BEGIN
  171.         I := I MOD Lim;
  172.         IF I = 0 THEN
  173.         Begin
  174.            PrintAddress(NextLL);
  175.            SetCol(Indent);
  176.         End;
  177.         PrintByteList(U,1,1);
  178.         Inc(I);
  179.         Dec(Cnt);
  180.     END;
  181. END; {PrintBytesOff}
  182.  
  183. FUNCTION NilLG(L: LG) : Boolean;                {.CP02}
  184. BEGIN NilLG := (L.UntLL = 0) AND (L.UntId = 0) END;
  185.  
  186. Function GetArrayBounds(U: UnitPtr; Arg: LG):String;        {.CP14}
  187. Var Tp: TypePtr; V: DNamePtr; Tu: UnitPtr; R: RespLG; Bl,Bu: String[12];
  188. Begin
  189.    GetArrayBounds := '';
  190.    V := AddrLGUnit(U,Arg);        {Point to Host Unit Name}
  191.    ResolveLG(V^.DSymb,Arg,R);        {Find Unit in Heap}
  192.    Tu := R.Uptr;                        {Get Ptr to Host Unit}
  193.    If Tu <> Nil Then
  194.    Begin
  195.       Tp := TypePtr(PtrAdjust(Tu,Arg.UntLL)); {to bounds descriptor}
  196.       Str(Tp^.LoBnd, Bl); Str(Tp^.HiBnd, Bu);
  197.       GetArrayBounds := Bl + '..' + Bu;
  198.    End;
  199. End; {GetArrayBounds}
  200.  
  201. PROCEDURE PrintLG(U : UnitPtr; LGS: LGClass; S : String);    {.CP38}
  202. CONST
  203.    LG_Txt : Array[LGClass] Of LGString =
  204.           ({LG_ABSQ} 'ABSOLUTE Target-Stub',
  205.         {LG_ARBC} 'Array[',        {LG_ASGN} 'Assgn Cmpat Type',
  206.         {LG_BASE} 'Base Type',    {LG_CONS} 'CONST Cmpat Type',
  207.         {LG_FUNR} 'Return Result',    {LG_OBJP} 'Ancestor Object',
  208.         {LG_PARM} 'Parm ',        {LG_TYPE} 'Named Type');
  209.  
  210. VAR L: LG; V : DNamePtr; R: RespLG; X: _UnitName; W : String;
  211. BEGIN
  212.         L := LG(Ptr(Seg(U^),Ofs(U^)+NextLL)^);
  213.     IF NOT NilLG(L) THEN
  214.     BEGIN
  215.              V := AddrLGUnit(U,L);        {point to Unit Entry}
  216.          X := '';                {its name}
  217.              R.Ownr := $FFFF;
  218.              If V <> Nil Then
  219.          Begin
  220.             X := V^.DSymb;
  221.         ResolveLG(X,L,R)
  222.              End;
  223.              If (R.Ownr <> $FFFF) AND (R.Ownr <> 0) Then
  224.          Begin
  225.              W := X + '.' + NameOfMethod(R.Uptr,R.Ownr);
  226.                 If LGS <> LG_PARM Then S := '' End
  227.              Else  W := 'in [' + X + '] ';
  228.          W := 'LG(' + W + ') ' + LG_Txt[LGS];
  229.              If LGS = LG_ARBC
  230.          Then W := W + GetArrayBounds(U,L) +']'
  231.          Else W := W + S;
  232.              S := W;
  233.     END Else S := 'LG(nil type) ' + S;
  234.     PrintAddress(NextLL);
  235.     PrintByteList(U,4,1);
  236.     SetCol(TabStop);
  237.     PutTxt(S);
  238. END; {PrintLG}
  239.  
  240. PROCEDURE BoundaryAlign(UH : UnitPtr);                {.CP12}
  241. VAR I : Integer;
  242. BEGIN {BoundaryAlign}
  243.     I := ((NextLL + $F) AND Masker) - NextLL;
  244.     IF I > 0 THEN
  245.     BEGIN
  246.         PrintBytes(UH,I,8);
  247.         SetCol(36);
  248.         PutTxt('Align to Paragraph Boundary');
  249.         NewTxtLine
  250.     END;
  251. END;  {BoundaryAlign}
  252.  
  253. PROCEDURE PrintOffset(Base: Word);                {.CP06}
  254. BEGIN
  255.      IF ColumnsUsed <> 0 THEN NewTxtLine;
  256.      PutTxt(HexA(NextLL));SetCol(7);
  257.      PutTxt('[+'+HexW(NextLL-Base)+'] ');
  258. END;
  259.  
  260. PROCEDURE PrintCodeBytes(U : UnitPtr;                {.CP38}
  261.             Count,        { Byte Count }
  262.             Limit,        { Max Bytes/Line }
  263.             Base: Word;    { Offset Origin  }
  264.             X : Boolean);   { ASCII Panel     }
  265. CONST Xlat : SET OF Char = [' '..Chr($7F)];
  266. VAR I : Integer; j, k : Word; S : String;  C : ^Char;
  267. BEGIN
  268.     j := 0; S := ''; k := Limit*3 + 17;    { ASCII Panel Tab Stop }
  269.     WHILE Count > 0 DO BEGIN
  270.         I := j MOD Limit;    { I = 0 if Line Full }
  271.         IF I = 0 THEN
  272.         BEGIN
  273.             IF X AND (J > 0) THEN    { ASCII & Data on Line }
  274.             BEGIN
  275.                 SetCol(K);
  276.                 PutTxt(S); S := '';
  277.             END;
  278.             PrintOffset(Base);
  279.         END;
  280.         IF X THEN            { Compile ASCII Panel }
  281.         BEGIN
  282.             C :=Ptr(Seg(U^),Ofs(U^)+NextLL-OffsetLL);
  283.             IF C^ IN Xlat THEN S := S + C^
  284.                       ELSE S := S + '.'
  285.         END;
  286.         PrintByteList(U,1,1);        { Print a Hex Byte }
  287.         Inc(j);
  288.         Dec(Count);
  289.     END;
  290.     IF X THEN                { Emit ASCII Panel }
  291.     BEGIN
  292.         SetCol(K);
  293.         PutTxt(S);
  294.         S := '';
  295.     END;
  296. END; {PrintCodeBytes}
  297.  
  298. PROCEDURE PrintListBytes(U: UnitPtr;                {.CP35}
  299.              Pfx,        { Bytes to Omit from ASCII Panel }
  300.              Count,        { Bytes to Print }
  301.              Limit,        { Max Bytes/Line }
  302.              Base: Word);    { Offset Origin     }
  303. CONST Xlat : SET OF Char = [' '..Chr($7F)];
  304. VAR I : Integer; j, k : Word; S : String;  C : ^Char;
  305. BEGIN
  306.     j := 0; S := '='''; k := Limit*3 + 18;    { ASCII Panel Tab Stop }
  307.     WHILE Count > 0 DO BEGIN
  308.         I := j MOD Limit;
  309.         IF I = 0 THEN
  310.         BEGIN
  311.             IF J > 0 THEN
  312.             BEGIN
  313.                 SetCol(K);
  314.                 PutTxt(S);
  315.                 S := '';
  316.             END;
  317.             PrintOffset(Base);
  318.         END;
  319.         IF J > Pfx THEN        { ASCII Bytes to Compile }
  320.         BEGIN
  321.             C :=Ptr(Seg(U^),Ofs(U^)+NextLL-OffsetLL);
  322.             IF C^ IN Xlat THEN S := S + C^
  323.                       ELSE S := S + '.'
  324.         END;
  325.         PrintByteList(U,1,1);
  326.         Inc(j);
  327.         Dec(Count);
  328.     END;
  329.     SetCol(K);
  330.     PutTxt(S+'''');
  331.     S := '';
  332. END; {PrintListBytes}
  333.  
  334. PROCEDURE PrintUnknowns(U: UnitPtr; Till: LL);            {.CP06}
  335. BEGIN {PrintUnknowns}
  336.     PrintTitleBlk('The Purpose of the data below is Unknown',1);
  337.     PrintBytes(U,Till-NextLL,8);
  338.     NewTxtLine;
  339. END;  {PrintUnknowns}
  340.  
  341. PROCEDURE FormatHeader(U : UnitPtr);                {.CP42}
  342. VAR I: Integer; J: Word; W: String;
  343. BEGIN
  344.     NoteBegin('Formatting Unit Header');
  345.     PrintAddress(NextLL);
  346.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHEYE[I]))+' ');
  347.     SetCol(TabStop);
  348.     PutTxt('=''');
  349.     FOR I := 0 TO 3 DO PutTxt(U^.UHEYE[I]);
  350.     PutTxt('''');
  351.     NewTxtLine;
  352.     Inc(NextLL,4);
  353.     PrintAddress(NextLL);
  354.     FOR I := 0 TO 3 DO PutTxt(HexB(Byte(U^.UHxxx[I]))+' ');
  355.     NewTxtLine;
  356.     Inc(NextLL,4);
  357.     PrintLL(U,'Dict Hdr-This Unit');
  358.     PrintLL(U,'INTERFACE Hash Table');
  359.     PrintLL(U,'PROC Map');
  360.     PrintLL(U,'CSEG Map');
  361.     PrintLL(U,'DSEG Map-Typed CONST''s');
  362.     PrintLL(U,'DSEG Map-Global VARs');
  363.     PrintLL(U,'DLL Module List');
  364.     PrintLL(U,'Donor Unit List');
  365.     PrintLL(U,'Source File List');
  366.         With U^ Do If UHDBT = UHZDA
  367.         Then PrintWd(U,'No Trace Table')
  368.     Else PrintLL(U,'Debug TRACE Table');
  369.     PrintWd(U,'Size of DICTIONARY Area');
  370.     PrintWd(U,'CSEG Size (Aggregate)');
  371.     PrintWd(U,'DSEG Size (Typed CONST''s)');
  372.     PrintWd(U,'Fix-Up List Size (CSegs)');
  373.     PrintWd(U,'Fix-Up List Size (Typed CONST''s)');
  374.     PrintWd(U,'DSEG Size (Global VARs)');
  375.     PrintLL(U,'DEBUG Hash Table');
  376.         J := U^.UHSOV;
  377.         W := '';
  378.         If Odd(J SHR 2) Then    { WINDOWS }
  379.         BEGIN
  380.            W := 'TPW';
  381.            If Odd(J)
  382.        Then W := W + ',{$E+}' Else W := W + ',{$E-}';
  383.            If Odd(J SHR 4)
  384.            Then W := W + ',Moveable' Else W := W + ',Fixed';
  385.            If Odd(J SHR 6)
  386.            Then W := W + ',Preload' Else W := W + ',Demandload';
  387.            If Odd(J SHR 12)
  388.            Then W := W + ',Discardable' Else W := W + ',Permanent';
  389.            If (J AND $EFAA) <> 0 Then W := W + ',Unknown Flags';
  390.         END ELSE
  391.         BEGIN            { MS-DOS }
  392.            W := 'TP6';
  393.        If Odd(J SHR 1)
  394.        Then W := W + ',{$O+}';
  395.            If Odd(J) Then W := W + ',{$E+}' Else W := W + ',{$E-}';
  396.            If (J AND $FFFC) <> 0 Then W := W + ',Unknown Flags';
  397.         END;
  398.         PrintWd(U,W);
  399.     NewTxtLine;
  400.     IF NextLL < U^.UHIHT THEN PrintUnknowns(U,U^.UHIHT);
  401.     NoteEnd;
  402. END; {FormatHeader}
  403.  
  404. PROCEDURE FormatDictionary(U : UnitPtr);            {.CP19}
  405.  
  406.    PROCEDURE PrintDictEntry;
  407.    VAR D, DB: DNamePtr; S: DStubPtr; I: Integer; It: Byte;
  408.        RP: VarStubPtr; DF: Char; DFM: String[8];
  409.        T : String[44]; W : String;
  410.    BEGIN {PrintDictEntry}
  411.       D := AddrDict(U,SurveyWork.LocLL); S := AddrStub(D);
  412.       RP := @S^.sRVF;
  413.       WITH SurveyWork, D^, S^ DO
  414.       BEGIN
  415.          DF := Public(DForm);
  416.          IF DF <> DForm Then DFM := 'Private ' Else DFM := '';
  417.          I := 4+(Length(DSymb) SHR 4);
  418.      CASE DF OF 'R','Y': Inc(I,4);
  419.                         'S': Inc(I,6);
  420.                     'P': Inc(I,2);
  421.            'Q','O','T'..'X': Inc(I);
  422.      END; {CASE}
  423.      W := '';                        {.CP12}
  424.      IF DF = 'R' THEN
  425.               Case sRAM Of
  426.           $08: IF SurveyWork.LocOwn <> 0
  427.                THEN W := NameOfMethod(U,SurveyWork.LocOwn);
  428.                   $10,$01,$00: ;
  429.           ELSE IF RP^.ROB <> 0 THEN W := NameOfMethod(U,RP^.ROB);
  430.               End; {Case}
  431.      IF W = '???' THEN W := '' ELSE
  432.      IF W <> ''   THEN W := W + '.';
  433.      PrintTitleBlk('Dictionary Entry For: "'+ W +
  434.      NameOfMethod(U,SurveyWork.LocLL)+'"',I);
  435.      IF HLink <> 0                        {.CP06}
  436.         THEN PrintLL(U,AddrDict(U,HLink)^.DSymb)
  437.         ELSE PrintWd(U,'(no backward link)');
  438.      PrintBytes(U,1,1);
  439.      SetCol(TabStop);
  440.      PutTxt(DFM+'Type "'+DF+'" -> ');
  441.      CASE DF OF                        {.CP18}
  442.        'O': W := 'GOTO Label';  'P': W := 'Un-Typed CONST';
  443.        'Y': W := 'Unit';        'T': W := 'Built-In Procedure';
  444.        'W': W := 'Port Array';  'U': W := 'Built-In Function';
  445.        'Q': W := 'Named Type';  'V': W := 'Built-In "NEW"';
  446.        'X': W := 'MEM_ Array';
  447.        'R': CASE sRAM OF
  448.           $00: W := 'Global VAR';
  449.           $01: W := 'Typed CONST';
  450.           $02: W := 'Local VAR (on Stack)';
  451.           $03: W := 'Absolute VAR [Seg:Ofs]';
  452.           $06: W := 'Self VAR (ADDR on Stack)';
  453.           $08: W := 'Record/Object Field';
  454.           $10: W := 'Absolute VAR (Equated)';
  455.           $22: W := 'VALUE Arg on Stack';
  456.           $26: W := 'VAR Arg on Stack';
  457.           Else W := 'New Data Type';
  458.         END; {CASE sRAM}
  459.        'S': IF sSVM = 0 Then                {.CP13}
  460.            Case (sSTp AND $70) Of
  461.              $10: W := 'Method';
  462.              $30: W := 'Constructor';
  463.              $50: W := 'Destructor';
  464.              Else W := 'Subprogram'
  465.            End
  466.         Else If (sSxx AND $10) <> 0
  467.             Then W := 'Dynamic Method'
  468.             Else W := 'Virtual Method';
  469.      END; {CASE DF OF}
  470.      PutTxt(W);
  471.      PrintBytes(U,Length(DSymb)+1,16);
  472.      SetCol(TabStop); PutTxt('="'+DSymb+'"');
  473.      NewTxtLine;
  474.      CASE DF OF { Format the Stub Part }            {.CP13}
  475.        'O': PrintWd(U,'Unknown purpose)');
  476.        'P': BEGIN
  477.            PrintLG(U,LG_CONS,'');
  478.            PrintBytes(U,LastLL-NextLL,8); {Temporary Fix}
  479.            {since value can be a string, we really need to check
  480.             the type descriptor out but that usually lies in the
  481.             system unit.  We circumvent for now by relying on the
  482.             distance to the next structure to determine the size
  483.             of the constant data for print purposes }
  484.            SetCol(TabStop); PutTxt('Constant Value');
  485.            NewTxtLine;
  486.             END; {CASE 'P'}
  487.        'Y': BEGIN                        {.CP07}
  488.            PrintWd(U,'TURBO Work?');
  489.            PrintWd(U,'Unit Version Number???');
  490.            PrintLL(U,'next unit in list');
  491.            PrintLL(U,'prior unit in list');
  492.            NewTxtLine;
  493.             END; {CASE 'Y'}
  494.    'T','U','V': BEGIN                        {.CP04}
  495.            PrintWd(U,'Meaning Unknown');
  496.            NewTxtLine;
  497.         END;
  498.        'W': BEGIN                        {.CP04}
  499.            PrintSoloByte(U,'0=byte array, 1=word array');
  500.            NewTxtLine;
  501.             END;
  502.        'Q','X': BEGIN                        {.CP04}
  503.            PrintLG(U,LG_TYPE,'');
  504.            NewTxtLine;
  505.         END;
  506.        'R': BEGIN                        {.CP49}
  507.            It := sRAM AND $1F;
  508.            CASE sRAM OF
  509.                       $00: T := 'Global VAR in DS';
  510.                       $01: T := 'Typed CONST in DS';
  511.                       $02: IF RP^.ROfs > $7FFF
  512.                  THEN T := 'Local VAR on Stack'
  513.                              ELSE T := 'VALUE(Stack)';
  514.                       $03: T := 'Absolute [Seg:Ofs]';
  515.                       $06: T := 'ADDR(Self) on Stack';
  516.                       $08: T := 'Record/Object Field';
  517.                       $10: T := 'Absolute Equivalence';
  518.                       $22: T := 'Arg On Stack (VALUE)';
  519.                       $26: T := 'Arg On Stack (VAR)';
  520.                       ELSE T := '**** NEW CODE TO CHECK ****'
  521.            END; {CASE sRAM}
  522.            PrintSoloByte(U,T);
  523.            T := '';
  524.                    Case It Of
  525.                      $03: Begin
  526.                              PrintWd(U,'Absolute Offset');
  527.                              PrintWd(U,'Absolute Segment');
  528.                           End;
  529.                      $10: PrintLG(U,LG_ABSQ,'');
  530.                      Else
  531.                      Begin
  532.             IF (It = $2) OR (It = $6) THEN With RP^ DO
  533.             IF RP^.ROfs > $7FFF
  534.                THEN T := 'BP-'+HexW($10000-ROfs)
  535.                ELSE T := 'BP+'+HexW(ROfs)
  536.             ELSE T := 'bytes';
  537.             PrintWd(U,'allocation offset ('+T+')');
  538.             CASE It OF
  539.                           $0: T := 'Entry offset in VAR DSeg Map';
  540.                           $1: T := 'Entry offset in CON DSeg Map';
  541.                           $2,$6:
  542.                                 IF RP^.ROB = 0
  543.                 THEN T := 'no containing scope'
  544.                 ELSE T := 'LL(containing Scope)';
  545.               $8: IF RP^.ROB = 0
  546.                               THEN T := 'no successor field/method'
  547.                               ELSE T := 'LL(successor field/method)';
  548.               ELSE T := 'Usage Unknown'
  549.             END; {CASE It}
  550.             PrintWd(U,T);
  551.                      End {Case It}
  552.                    End; {Case sRAM}
  553.            PrintLG(U,LG_BASE,'');
  554.             END; {CASE 'R'}
  555.        'S': BEGIN                        {.CP37}
  556.            T := '';
  557.            IF ((sSTp AND $01) = 0) AND ((sSTp AND $16) = 0)
  558.                    THEN T := '+NEAR'
  559.                    ELSE IF  (sSTp AND $10) <> 0 THEN
  560.                     CASE (sSTp AND $60) OF
  561.                   $00: T := '+Method';
  562.                               $20: T := '+Constructor';
  563.                   $40: T := '+Destructor';
  564.                   ELSE T := '+Method?'
  565.                     END;
  566.            IF (sSTp AND $08) <> 0 THEN T := T + '+EXTERNAL';
  567.            IF (sSTp AND $01) <> 0 THEN T := T + '+FAR';
  568.            IF (sSTp AND $02) <> 0 THEN T := T + '+INLINE';
  569.                    IF (sSTp AND $04) <> 0 THEN T := T + '+INTERRUPT';
  570.                    IF (sSTp AND $80) <> 0 THEN T := T + '+ASSEMBLER';
  571.            IF Length(T) > 0 THEN Delete(T,1,1);
  572.            PrintSoloByte(U,T);
  573.                    T := 'PMap Flags';
  574.                    If (sSxx AND $04) <> 0 Then
  575.                        If (sSxx AND $08) <> 0
  576.             Then T := 'DLL ref by NAME'
  577.             Else T := 'DLL ref by INDEX'
  578.            Else If (sSxx AND $10) <> 0 Then T := 'Dynamic Method';
  579.                    PrintSoloByte(U,T);
  580.            IF (sSTp AND $02) <> 0  THEN T := 'INLINE Code Bytes'
  581.                                ELSE T := 'offset in PROC Map';
  582.            PrintWd(U,T);
  583.            IF sSPS = 0    THEN T := 'no containing scope'
  584.                 ELSE T := 'LL(containing scope)';
  585.            PrintWd(U,T);
  586.            IF sSHT = 0    THEN T := 'no local Hash Table'
  587.                 ELSE T := 'LL(local scope Hash Table)';
  588.            PrintWd(U,T);
  589.            IF sSVM = 0    THEN T := 'Not Used' ELSE
  590.            If (sSxx AND $10) <> 0
  591.            THEN T := 'Dynamic Method Index'
  592.                    ELSE T := 'Method Ptr Offset in VMT';
  593.            PrintWd(U,T);
  594.            SetCol(1);
  595.             END; {CASE 'S'}
  596.      END; {CASE DF OF}
  597.       END; {WITH}
  598.  
  599.    END;  {PrintDictEntry}
  600.  
  601.    PROCEDURE PrintTypeEntry;                    {.CP53}
  602.    VAR T : TypePtr; D : DNamePtr; I : Integer; W : String[64];
  603.  
  604.    BEGIN {PrintTypeEntry}
  605.       T := TypePtr(PtrAdjust(U,SurveyWork.LocLL)); I := 0;
  606.       CASE T^.tpTC OF
  607.         $01, $02, $09: I := 2; $04, $05, $07, $08: I := 1;
  608.              $0C..$0F: I := 3; $03: I := 10;  $06: I := 7 + 2*T^.PNPrm;
  609.       END; {CASE}
  610.       W := '';
  611.       IF SurveyWork.LocOwn <> 0
  612.       THEN W := NameOfMethod(U,SurveyWork.LocOwn) ELSE
  613.       IF T^.tpTC = $03 THEN W := NameOfMethod(U,T^.ObjtName);
  614.       IF (W <> '') AND (W <> '???') THEN W := ' For: "' + W + '"';
  615.       PrintTitleBlk('Type Descriptor' + W,I+2);
  616.       WITH T^ DO BEGIN
  617.          PrintBytes(U,2,8);SetCol(TabStop);
  618.          CASE tpTC OF
  619.            $00: W := 'un-typed';  $01: W := 'Array';
  620.            $02: W := 'Record';    $03: W := 'Object';
  621.            $04: W := 'File';      $05: W := 'Text';
  622.            $06: If NilLG(PFRes)
  623.         Then W := 'Procedure'
  624.         Else W := 'Function';
  625.            $07: W := 'Set';
  626.            $08: W := 'Pointer';   $09: W := 'String';
  627.            $0A: CASE tpTQ OF
  628.                   $00: W := 'Single'; $02: W := 'Extended';
  629.           $04: W := 'Double'; $06: W := 'Comp';
  630.           ELSE W := '8087-Floating?'
  631.             END; {CASE tpTQ}
  632.            $0B: W := 'Real';
  633.            $0C: CASE tpTQ OF
  634.           $00: W := 'un-named byte integer';  $01: W := 'ShortInt';
  635.                   $02: W := 'Byte';      $04: W := 'un-named word integer';
  636.                   $05: W := 'Integer';   $06: W := 'Word';
  637.                   $0C: W := 'un-named DWORD integer';
  638.                   $0D: W := 'LongInt';
  639.                   ELSE W := 'unknown integer type';
  640.                 END; {CASE tpTQ}
  641.            $0D: W := 'Boolean';     $0E: W := 'Char';
  642.            $0F: W := 'enumeration';
  643.            ELSE W := 'unknown type code';
  644.          END; {CASE tpTC OF}
  645.          PutTxt('Type='+W);
  646.          PrintWd(U,'Storage Width (bytes)');
  647.          If tpML = 0
  648.            Then If tpTC = $06
  649.                 Then PrintWd(U,'NO Next Method')
  650.                 Else PrintWd(U,'Usage Unknown')
  651.            Else If tpTC = $06
  652.            Then PrintLL(U,'Dict Hdr, Next Method')
  653.         Else PrintWd(U,'Meaning Unknown');
  654.          CASE tpTC OF                        {.CP05}
  655.            $01: BEGIN
  656.            PrintLG(U,LG_BASE,'');
  657.            PrintLG(U,LG_ARBC,'');
  658.         END;
  659.        $02: BEGIN                        {.CP04}
  660.            PrintLL(U,'Field List Hash Table');
  661.            PrintLL(U,'Dict Entry of 1st Field');
  662.         END;
  663.        $03: BEGIN                        {.CP22}
  664.            PrintLL(U,'Field/Method Hash Table');
  665.            PrintLL(U,'Field/Method Dictionary');
  666.            IF NilLG(ObjtOwnr)
  667.             THEN PrintDWd(U,'nothing inherited')
  668.             ELSE PrintLG(U,LG_OBJP,'');
  669.            PrintWd(U,'Size of VMT (bytes)');
  670.            IF ObjtDMap = $FFFF
  671.             THEN PrintWd(U,'there is no VMT')
  672.             ELSE PrintWd(U,'DSeg Map Offset of VMT Template');
  673.            IF ObjtVMTO = $FFFF
  674.             THEN PrintWd(U,'Object has no VIRTUAL Methods')
  675.             ELSE PrintWd(U,'Offset in Object to VMT Pointer');
  676.            D := AddrDict(U,ObjtName);
  677.            PrintLL(U,'Dict Entry ('+D^.DSymb+')');
  678.            IF ObjtDMTp = $FFFF
  679.             Then PrintWd(U,'Object has no DYNAMIC Methods')
  680.             Else PrintWd(U,'DSeg Map Offset of DMT Template');
  681.            PrintBytes(U,6,8);
  682.                    SetCol(TabStop);
  683.                    PutTxt('Usage Unknown');
  684.         END;
  685.        $06: BEGIN                        {.CP21}
  686.               IF NilLG(PFRes)
  687.            THEN PrintDWd(U,'Procedures have no Result')
  688.            ELSE PrintLG(U,LG_FUNR,'');
  689.            IF PNPrm = 0 THEN PrintWd(U,'no parameter list') ELSE
  690.            BEGIN
  691.               Str(PNPrm,W); W := W + ' Formal Parameter';
  692.               IF PNPrm > 1 THEN W := W + 's';
  693.               PrintWd(U,W);
  694.               FOR I := 1 TO PNPrm DO WITH PFPar[I] DO BEGIN
  695.             Str(I,W);
  696.             PrintLG(U,LG_PARM,W);
  697.             IF fPAM = $02
  698.             THEN W := 'Pass VALUE on Stack'
  699.             ELSE IF fPAM = $06
  700.                 THEN W := 'Pass ADDRESS on Stack'
  701.                 ELSE W := '**** NEW CODE VALUE ***';
  702.             PrintSoloByte(U,W)
  703.               END; {FOR}
  704.            END;
  705.         END;  { CASE $06 }
  706.        $04: PrintLG(U,LG_BASE,' FILE');            {.CP08}
  707.        $05: PrintLG(U,LG_BASE,' TEXT');
  708.        $07: PrintLG(U,LG_BASE,' SET');
  709.        $08: PrintLG(U,LG_BASE,' POINTER');
  710.        $09: BEGIN
  711.            PrintLG(U,LG_BASE,'STRING');
  712.            PrintLG(U,LG_ARBC,'');
  713.         END;
  714.        $0C..                        {.CP12}
  715.        $0F: BEGIN
  716.               PrintBytes(U,SizeOf(T^.LoBnd),8);
  717.            SetCol(TabStop);PutTxt('Subrange Lower Bound');
  718.            PrintBytes(U,SizeOf(T^.HiBnd),8);
  719.            SetCol(TabStop);PutTxt('Subrange Upper Bound');
  720.            PrintLG(U,LG_ASGN,'');
  721.            END; { $0C,$0D,$0E,$0F}
  722.      END; {CASE tpTC OF}
  723.       END; {WITH}
  724.  
  725.    END;  {PrintTypeEntry}
  726.  
  727.    PROCEDURE PrintHashEntry;                    {.CP22}
  728.    VAR H : HashPtr;
  729.  
  730.     FUNCTION PrintEmptyHash(Bot,Top:Word):Word;
  731.     VAR  I, J, K : Word;
  732.     BEGIN
  733.        I := Bot;
  734.        WITH H^ DO REPEAT
  735.            IF Slt[I] = 0
  736.         THEN Inc(I)
  737.         ELSE Top := I-1;
  738.        UNTIL Top < I;
  739.        K := 0;
  740.        WITH H^ DO FOR J := Bot TO Top DO BEGIN
  741.           IF (K AND $3)=0 THEN PrintAddress(NextLL);
  742.           PutTxt(HexB(LO(Slt[J]))+' ');
  743.           PutTxt(HexB(HI(Slt[J]))+' ');
  744.           Inc(NextLL,2);
  745.           Inc(K);
  746.        END;
  747.        PrintEmptyHash := I
  748.     END; {PrintEmptyHash}
  749.  
  750.    VAR  D : DNamePtr; I, J, K, N : Word; W : String[44];    {.CP26}
  751.  
  752.    BEGIN {PrintHashEntry}
  753.        H := AddrHash(U,SurveyWork.LocLL);
  754.     N := H^.Bas DIV 2;
  755.     W := '';
  756.     IF SurveyWork.LocLL = U^.UHIHT
  757.     THEN W := '- INTERFACE Dictionary'    ELSE
  758.     IF SurveyWork.LocLL = U^.UHDHT
  759.     THEN W := '- Turbo DEBUG Dictionary'    ELSE
  760.     IF SurveyWork.LocOwn <> 0
  761.     THEN W := 'Owned By: "'+NameOfMethod(U,SurveyWork.LocOwn)+'"';
  762.     PrintTitleBlk('Hash Table '+W,3);
  763.     PrintWd(U,'Bytes in Hash Table - 2');
  764.     SetCol(1);PutTxt('-----');
  765.     I := 0;
  766.  
  767.     WITH H^ DO REPEAT
  768.        IF Slt[I] <> 0 THEN
  769.        BEGIN
  770.           PrintLL(U,AddrDict(U,Slt[I])^.DSymb);
  771.           Inc(I)
  772.        END ELSE I := PrintEmptyHash(I,N);
  773.     UNTIL I > N;
  774.     NewTxtLine;
  775.    END;  {PrintHashEntry}
  776.  
  777.    PROCEDURE PrintInLineEntry;                    {.CP15}
  778.    VAR D : DNamePtr; S : DStubPtr; I : Integer;  T : TypePtr;
  779.  
  780.    BEGIN {PrintInLineEntry}
  781.       D := AddrDict(U,SurveyWork.LocOwn);   { Procedure  Header }
  782.       S := AddrStub(D);                     { Procedure  Stub   }
  783.       T := AddrProcType(S);                 { Type Descriptor   }
  784.       WITH SurveyWork, T^ DO BEGIN
  785.      I := (S^.sSPM+15) SHR 4;
  786.      PrintTitleBlk('INLINE Code Bytes FOR: "'+
  787.              NameOfMethod(U,SurveyWork.LocOwn)+'"',I);
  788.      PrintBytes(U,S^.sSPM,16);
  789.      SetCol(1);
  790.       END;
  791.    END;  {PrintInLineEntry}
  792.  
  793. VAR I: Word; BU: SurveyRec; DoneDict, DoneHash: Boolean; BUL: LL; {.CP30}
  794. BEGIN {FormatDictionary}
  795.     NoteBegin('Formatting Dictionary');
  796.     DoneHash := False; DoneDict := False;
  797.         FetchSurveyRec(SurveyWork);
  798.     WITH SurveyWork DO
  799.     While LocTyp <> cvNULL DO BEGIN
  800.                 LastLL := LocNxt;
  801.         BU := SurveyWork;
  802.         IF NextLL < LocLL THEN
  803.         IF NOT DoneHash THEN PrintUnknowns(U,LocLL) ELSE
  804.                 IF DoneDict     THEN PrintUnknowns(U,LocLL) ELSE
  805.         BEGIN
  806.             BUL := LastLL;
  807.             LocLL := NextLL; LastLL := BU.LocLL;
  808.             LocOwn := 0; LocTyp := cvType;
  809.             PrintTypeEntry;
  810.             SurveyWork := BU; LastLL := BUL;
  811.         END;
  812.         CASE LocTyp OF
  813.              cvName: BEGIN PrintDictEntry; DoneDict := True END;
  814.              cvType: PrintTypeEntry;
  815.              cvHash: BEGIN PrintHashEntry; DoneHash := True END;
  816.              cvINLN: PrintInLineEntry;
  817.         END; {CASE}
  818.                 FetchSurveyRec(SurveyWork);
  819.     END;   {While}
  820.     IF NextLL < U^.UHPMT THEN PrintUnknowns(U,U^.UHPMT);
  821.     NoteEnd;
  822. END;  {FormatDictionary}
  823.  
  824. FUNCTION NameOfObject(U: UnitPtr; UsrDE: LL): _LexName;        {.CP15}
  825. VAR D: DNamePtr; T: TypePtr;
  826. BEGIN
  827.    NameOfObject := '???';
  828.    IF UsrDE <> $0000 THEN
  829.    BEGIN
  830.     T  := TypePtr(PtrAdjust(U,UsrDE));    {to Object TD}
  831.     D  := Nil;
  832.     IF T^.tpTC = $03 THEN
  833.     BEGIN
  834.        D  := DNamePtr(PtrAdjust(U,T^.ObjtName)); {to Object DE}
  835.        NameOfObject := D^.Dsymb
  836.     END
  837.    END
  838. END;  {NameOfObject}
  839.  
  840. PROCEDURE CSegHeadings; Far;                    {.CP45}
  841. BEGIN
  842.    SetCol(8);
  843.    PutTxt('Entry  Turbo Segmt FixUp Trace :  Load  [Fix-Ups]  Source File');
  844.    SetCol(8);
  845.    PutTxt('Offset Work? Bytes Bytes Entry :  ADDR  1''st  Last For CODE Seg');
  846.    SetCol(8);
  847.    PutTxt('------ ----- ----- ----- ----- : ----- ----- ----- ------------');
  848. END; {CSegHeadings}
  849.  
  850. PROCEDURE FormatCSegMap(UPt: UnitPtr);
  851.  
  852. VAR    C: CMapTabPtr; SF: SrcFilePtr;
  853.     OldTabSet, Base, Cx, NMapC : Word;
  854. BEGIN
  855.     NMapC := Upt^.UHTMT - Upt^.UHCMT; Cx := 0;
  856.  
  857.     IF NMapC > 0 THEN    { make sure CSeg Map non-empty }
  858.     BEGIN
  859.         NoteBegin('Formatting CSeg Map');
  860.         OldTabSet := TabStop;
  861.         TabStop := 41;
  862.         PrintTitleBlk('CSeg Map Table',7);
  863.         NextLL := Upt^.UHCMT;
  864.         CSegHeadings;  Base := NextLL;
  865.         REPEAT
  866.            PageOverFlow(6,CSegHeadings);
  867.                    FetchMapRef(Map,rCSEG,Cx);
  868.            SF := AddrSrcTabOff(UPt,Map.MapSrc);
  869.            PrintCodeBytes(UPt,8,8,Base,False);
  870.            SetCol(TabStop);
  871.            PutTxt(HexA(Map.MapLod+Base_Code)+' ');
  872.            IF Map.MapFxJ <> 0 THEN With Map Do
  873.            BEGIN
  874.               PutTxt(HexA(MapFxI+Base_FixC)+' ');
  875.               PutTxt(HexA(MapFxJ+MapFxI-SizeOf(FixUpRec)+Base_FixC));
  876.            END;
  877.            SetCol(TabStop+18);
  878.            PutTxt(SF^.SrcName);
  879.            Inc(Cx,SizeOf(CMapRec));
  880.         UNTIL Cx > NMapC-1;
  881.         TabStop := OldTabSet;
  882.         NoteEnd;
  883.     END;
  884. END;  { FormatCSegMap }
  885.  
  886. PROCEDURE ProcHeadings; Far;                    {.CP55}
  887. BEGIN
  888.   SetCol(8); PutTxt('                         Entry   DLL-Name/');
  889.   SetCol(8); PutTxt('Entry  Turbo PROC  CSeg  Ofset : Jump  Byte Name Of');
  890.   SetCol(8); PutTxt('Offset Work? Flags Map^  /Indx : Addr  Cnt  Procedure');
  891.   SetCol(8); PutTxt('------ ----- ----- ----- ----- : ----- ---- ----------');
  892. END; {ProcHeadings}
  893.  
  894. PROCEDURE FormatProcMap(UPt: UnitPtr);
  895. VAR Base, I, OldTabStop: Word; W, WB: String[11]; S: DLLPtr; J, K: LongInt;
  896. BEGIN {FormatProcMap}
  897.     IF CountPMapSlots(UPt) > 0 THEN  { Make Sure PROC Map not empty }
  898.     BEGIN
  899.         NoteBegin('Formatting PROC Map');
  900.         FillChar(WB,SizeOf(WB),' ');
  901.                 WB[0] := Chr(SizeOf(WB)-1);
  902.         OldTabStop := TabStop;
  903.         TabStop := 41;
  904.         SetCol(1);
  905.         PrintTitleBlk('PROC Map Table',8);
  906.         NextLL := Upt^.UHPMT;
  907.         I := 0; Base := NextLL;
  908.         ProcHeadings;
  909.         REPEAT
  910.            PageOverFlow(4,PROCHeadings);
  911.                    FetchMapRef(Map,rPROC,I);
  912.            PrintCodeBytes(UPt,8,8,Base,False);
  913.            SetCol(TabStop);
  914.                    With Map Do If MapTyp = mfPDLL Then
  915.                    Begin
  916.                       W := WB;
  917.                       S := AddrDLLTabOff(UPt,MapSrc);
  918.                       If S <> Nil Then
  919.                          Move(S^.DLLMod[1],W[1],Ord(S^.DLLMod[0]));
  920.                       PutTxt(W+NameOfMethod(UPt,MapOwn));
  921.                    End Else
  922.                    Begin
  923.                       If MapCSM <> $FFFF Then
  924.               Begin
  925.                          K := Base_Code + MapEPT;
  926.                  PutTxt(HexA(K)+' ');
  927.                  PutTxt(HexW(MapSiz)+' ');
  928.                       End Else SetCol(TabStop+11);
  929.               IF MapTyp = mfPRUI THEN
  930.             IF MapCSM = $FFFF
  931.             THEN PutTxt('Not Used (No Unit Init Code)')
  932.             ELSE PutTxt('Unit Init Code')
  933.               ELSE PutTxt(NameOfMethod(UPt,MapOwn));
  934.                    End;
  935.            Inc(I,SizeOf(PMapRec));
  936.         UNTIL NextLL >= Upt^.UHCMT;
  937.         TabStop := OldTabStop;
  938.         NoteEnd;
  939.     END;
  940. END; {FormatProcMap}
  941.  
  942. PROCEDURE CONSTHeadings; Far;                    {.CP53}
  943. BEGIN
  944.   SetCol(8); PutTxt('Entry  Turbo Segmt FixUp  VMT  :  Load  [Fix-Ups]');
  945.   SetCol(8); PutTxt('Offset Work? Bytes Bytes Owner :  ADDR  1''st last');
  946.   SetCol(8); PutTxt('------ ----- ----- ----- ----- : ----- ----- -----');
  947. END; {CONSTHeadings}
  948.  
  949. PROCEDURE FormatTypedConMap(UPt:UnitPtr);
  950. VAR I, J, K : Integer; Sofs, Base : Word;
  951. BEGIN { FormatTypedConMap }
  952.     J := CountDMapSlots(UPt);
  953.     IF J > 0 THEN
  954.     BEGIN
  955.         NoteBegin('Formatting CONST DSeg Map');
  956.         PrintTitleBlk('CONST DSeg Map Table',7);
  957.         K := TabStop;
  958.         TabStop := 59;
  959.         NextLL := Upt^.UHTMT;
  960.         Base := NextLL; Sofs := 0;
  961.         CONSTHeadings;
  962.         FOR I := 0 TO J-1 DO With Map Do
  963.         BEGIN
  964.            PageOverFlow(7,ConstHeadings);
  965.            FetchMapRef(Map,rCONS,Sofs);
  966.            PrintCodeBytes(UPt,8,8,Base,False);
  967.            PutTxt('  '+HexA(MapLod+Base_Data)+' ');
  968.            If MapFxJ > 0 Then
  969.            Begin
  970.               PutTxt(HexA(MapFxI+Base_FixD)+' ');
  971.               PutTxt(HexA(MapFxJ+MapFxI+Base_FixD-SizeOf(FixUpRec)));
  972.            End;
  973.            SetCol(TabStop);
  974.            IF (MapTyp = mfTVMT)
  975.            THEN PutTxt('VMT For: '+NameOfObject(UPt,MapOwn)) ELSE
  976.            IF (MapTyp = mfTDMT)
  977.            THEN PutTxt('DMT For: '+NameOfObject(UPt,MapOwn)) ELSE
  978.            Begin
  979.               PutTxt('From: ');
  980.               Case MapTyp Of
  981.             mfXTRN: PutTxt('Linked File');
  982.             mfINTF: PutTxt('_INTERFACE');
  983.             mfIMPL: PutTxt('_IMPLEMENTATION');
  984.             mfNEST: PutTxt('PROC('
  985.                      +NameOfMethod(Upt,MapOwn)+')');
  986.             Else    PutTxt('???');
  987.               End;
  988.            End;
  989.            Inc(Sofs,SizeOf(DMapRec));
  990.         END; { FOR }
  991.         TabStop := K;
  992.         NoteEnd;
  993.     END; { IF }
  994. END;  { FormatTypedConMap }
  995.  
  996. PROCEDURE VARHeadings; Far;                    {.CP42}
  997. BEGIN
  998.     SetCol(8); PutTxt('Entry  Turbo Segmt Usage Usage');
  999.     SetCol(8); PutTxt('Offset Work? Bytes  ???   ??? ');
  1000.     SetCol(8); PutTxt('------ ----- ----- ----- -----');
  1001. END; {VARHeadings}
  1002.  
  1003. PROCEDURE FormatGlobalVarMap(U : UnitPtr);
  1004.  
  1005. VAR Base, Sofs, I : Word; SaveTab : Integer;
  1006. BEGIN
  1007.     IF U^.UHDMT <> U^.UHDLL THEN
  1008.     BEGIN
  1009.         NoteBegin('Formatting Global VAR Map');
  1010.         SaveTab := TabStop;
  1011.         TabStop := 41;
  1012.         I := 0;
  1013.         PrintTitleBlk('Global VAR DSeg Map Table',5);
  1014.         VARHeadings;
  1015.         NextLL := U^.UHDMT;
  1016.         Base := NextLL;
  1017.                 Sofs := 0;
  1018.         WHILE U^.UHDLL > NextLL DO
  1019.         BEGIN
  1020.             PageOverFlow(5,VARHeadings);
  1021.             PrintCodeBytes(U,8,8,Base,False);
  1022.             SetCol(TabStop);
  1023.                         FetchMapRef(Map,rVARS,Sofs);
  1024.                         PutTxt('From: ');
  1025.                         Case Map.MapTyp Of
  1026.                           mfXTRN: PutTxt('Linked File');
  1027.                           mfINTF: PutTxt('_INTERFACE');
  1028.                           mfIMPL: PutTxt('_IMPLEMENTATION');
  1029.                           Else    PutTxt('???');
  1030.                         End;
  1031.                         Inc(Sofs,SizeOf(DMapRec));
  1032.             Inc(I);
  1033.         END;
  1034.         NoteEnd;
  1035.         TabStop := SaveTab;
  1036.     END;
  1037. END; {FormatGlobalVarMap}
  1038.  
  1039. PROCEDURE FormatDLLList(U: UnitPtr);                {.CP18}
  1040. Var P : DLLPtr; Base, I : LL;
  1041. Begin
  1042.    P := AddrDLLTabOff(U,0);
  1043.    If P <> Nil Then
  1044.    Begin
  1045.     NoteBegin('Formatting DLL List');
  1046.         SetCol(1);
  1047.         PrintTitleBlk('DLL List',2);
  1048.         Base := NextLL;
  1049.         While P <> Nil Do With P^ Do Begin
  1050.            I := Ord(DLLMod[0]) + SizeOf(DLLWrk) + 1;
  1051.            PrintListBytes(U,4,I,13,Base);
  1052.            P := AddrNxtDLL(U,P);
  1053.         End;
  1054.     NoteEnd;
  1055.    End;
  1056. End; {FormatDLLList}
  1057.  
  1058. PROCEDURE FormatUnitDonorList(U : UnitPtr);            {.CP20}
  1059. VAR UCP : UDonorPtr; I, J: LL;
  1060. BEGIN
  1061.     IF U^.UHLSF <> NextLL THEN
  1062.     BEGIN
  1063.        NoteBegin('Formatting Donor Unit List');
  1064.        SetCol(1);
  1065.        PrintTitleBlk('Code/Data Donor Unit List',2);
  1066.        UCP := UDonorPtr(PtrAdjust(U,U^.UHLDU));
  1067.            With UCP^ Do J := PtrDelta(@UDEnam,UCP);
  1068.        WHILE NextLL < U^.UHLSF DO WITH UCP^ DO BEGIN
  1069.           IF LinesRemaining < 2 THEN NewTxtPage;
  1070.               I := J + Ord(UDEnam[0]) + 1;
  1071.               PrintListBytes(U,J,I,13,U^.UHLDU);
  1072.           SetCol(1);
  1073.           UCP := UDonorPtr(PtrAdjust(UCP,I));
  1074.        END;
  1075.        NoteEnd;
  1076.     END;
  1077. END; {FormatUnitDonorList}
  1078.  
  1079. PROCEDURE FormatSourceFileList(U : UnitPtr);            {.CP34}
  1080. VAR S : SrcFilePtr; SLL: LL; Lines, OldTabStop : Integer;
  1081.     FlagCode: String[10]; Stamps : String[22];
  1082.  
  1083. BEGIN {FormatSourceFileList}
  1084.     NoteBegin('Formatting Source File List');
  1085.     OldTabStop := TabStop;
  1086.     TabStop := 47;
  1087.     PrintTitleBlk('Source File List',5);
  1088.     SLL := U^.UHDBT;
  1089.     S := SrcFilePtr(PtrAdjust(U,NextLL));
  1090.     WHILE SLL <> NextLL DO WITH S^ DO BEGIN
  1091.        Lines := Ord(SrcName[0]) DIV 11 + 2;
  1092.        IF LinesRemaining < Lines THEN NewTxtPage;
  1093.        PrintCodeBytes(U,7,16,U^.UHLSF,False);
  1094.            If SrcDate <> 0
  1095.        Then Stamps := ', '    + FormatDate(SrcDate) + ', '
  1096.                 + FormatTime(SrcTime)
  1097.            Else Stamps := '';
  1098.        CASE SrcFlag OF
  1099.         $03: FlagCode := 'Include ';
  1100.         $04: FlagCode := 'Primary ';
  1101.                 $06: FlagCode := 'Resource ';
  1102.         Else FlagCode := 'Linked ';
  1103.        END;   { CASE }
  1104.        SetCol(TabStop);PutTxt(FlagCode+'File'+Stamps);
  1105.        PrintBytesOff(U,1+Ord(SrcName[0]),11,15);
  1106.        SetCol(TabStop);PutTxt('='''+SrcName+'''');
  1107.        SetCol(1);
  1108.        S := AddrNxtSrc(U,S);
  1109.     END;
  1110.     TabStop := OldTabStop;
  1111.     NoteEnd;
  1112. END; {FormatSourceFileList}
  1113.  
  1114. PROCEDURE FormatTraceTable(U : UnitPtr);            {.CP38}
  1115. VAR    T : TraceRecPtr; S,X : String[6]; I,J, Limit : Word;
  1116. BEGIN
  1117.    T := AddrTraceTab(U);
  1118.    IF T <> Nil THEN
  1119.    BEGIN
  1120.     NoteBegin('Formatting Trace Table');
  1121.     SetCol(1);
  1122.     Limit := GetTrExecSize(T);
  1123.     PrintTitleBlk('Trace Table for Turbo Debugger is Next (LL at 001A)',
  1124.             7+(Limit SHR 3));
  1125.     WHILE T <> Nil DO WITH T^ DO BEGIN
  1126.         Limit := GetTrExecSize(T);
  1127.         IF LinesRemaining < (7+Limit SHR 3) THEN NewTxtPage;
  1128.         IF TrName <> 0
  1129.         THEN PrintLL(U,NameOfMethod(U,TrName))
  1130.         ELSE PrintWd(U,'Unit Init Code Block');
  1131.         PrintWd(U,'Src File: "' + AddrSrcTabOff(U,TrFill)^.SrcName + '"');
  1132.         Str(T^.TrPfx,S);  PrintWd(U,S+' Data bytes precede Code');
  1133.         Str(T^.TrBeg,S);  PrintWd(U,'BEGIN Stmt at Line # '+S);
  1134.         Str(T^.TrLNos,S); PrintWd(U,S+' Lines of Code to Execute');
  1135.         I := 1;
  1136.         WHILE I <= Limit DO BEGIN
  1137.             J := I + 7;
  1138.             IF J > Limit THEN J := Limit;
  1139.             Str(I-1+TrBeg,S); Str(J-1+TrBeg,X);
  1140.             PrintBytes(U,J+1-I,8);
  1141.             SetCol(TabStop);
  1142.             PutTxt('Code Bytes in Lines '+S+' Thru '+X);
  1143.             NewTxtLine;
  1144.             I := J + 1;
  1145.         END;
  1146.         T := AddrNxtTrace(U,T);
  1147.         NewTxtLine;
  1148.     END;
  1149.     NoteEnd;
  1150.    END;
  1151. END; {FormatTraceTable}
  1152.  
  1153. PROCEDURE FormatEndNonCode(U : UnitPtr);            {.CP05}
  1154. BEGIN
  1155.     PrintTitleBlk('End Unit Dictionary Area',0);
  1156.     BoundaryAlign(U);
  1157. END; {FormatEndNonCode}
  1158.  
  1159. PROCEDURE FormatObjectCode(UH : UnitPtr);            {.CP09}
  1160. VAR
  1161.    MyFil, MyTrc: LL; SaveTab: Word;
  1162.    CMaps, CXs, I, J: Integer; SF: Byte; SP: SrcFilePtr; R: FixUpPtr;
  1163.    UC: Pointer; HexOff, MyOrg, MyEnd: LongInt; PM: MapRefRec;
  1164.  
  1165.    PROCEDURE DisplayCode(  U : UnitPtr;    { Dictionary Pointer }
  1166.             Count: Word;    { Byte Count to Emit }
  1167.                TrcNdx: LL);    { Trace Entry Index  }
  1168.  
  1169.     PROCEDURE DisplayCodeLine(VAR P : ObjArg);        {.CP19}
  1170.         Var I: Word; T: String;
  1171.     BEGIN
  1172.        WITH P DO WHILE Lim > 0 DO BEGIN
  1173.           UnAssemble(UC,P);
  1174.           NextLL := Locn+OffsetLL;
  1175.           PrintOffset(HexOff);
  1176.               FillChar(T[1],SizeOf(T)-1,' ');
  1177.               T[0] := Chr(15-ColumnsUsed-1);
  1178.               T := T + Code;
  1179.               T[0] := Chr(38-ColumnsUsed-1);
  1180.               T := T + Mnem;
  1181.               T[0] := Chr(50-ColumnsUsed-1);
  1182.               IF Length(Opr1) > 0 THEN T := T + Opr1;
  1183.           IF Length(Opr2) > 0 THEN
  1184.           If Length(Opr1) > 0 Then T := T +','+Opr2 Else T := T + Opr2;
  1185.           IF Length(Opr3) > 0 THEN
  1186.           BEGIN
  1187.              IF Opr3[1] <> ';' THEN T := T + ';'
  1188.                     ELSE T := T + ' ';
  1189.          T := T + Opr3;
  1190.           END;
  1191.               TrimString(T);         { Removes trailing blanks }
  1192.               PutTxt(T);
  1193.           NewTxtLine;
  1194.        END;
  1195.     END;    {DisplayCodeLine}
  1196.  
  1197.    VAR P: ObjArg; I, J, K, L: Word; Limit, IP: LongInt;        {.CP42}
  1198.        T: TraceRecPtr; S: String[6];
  1199.    BEGIN   {DisplayCode}
  1200.       IF Count > 0 THEN
  1201.       BEGIN
  1202.          Limit := Count;
  1203.      IP  := NextLL;
  1204.      P.TCpu := CPUType;
  1205.      T := AddrTraceTab(U);
  1206.          J := IP - OffsetLL;
  1207.          P.CBase := Base_Code;
  1208.      P.Obj := J;
  1209.      IF (T = Nil) OR (TrcNdx = $FFFF) THEN
  1210.      BEGIN
  1211.         P.Lim := Limit;
  1212.         DisplayCodeLine(P);
  1213.      END ELSE
  1214.      BEGIN
  1215.         T := Ptr(Seg(T^),Ofs(T^)+TrcNdx);
  1216.         L := T^.TrBeg;
  1217.         K := GetTrExecSize(T);
  1218.         I := 1;
  1219.         WHILE I <= K DO BEGIN
  1220.         IF T^.TrExec[I] = $80 THEN Inc(I);
  1221.         P.Lim := T^.TrExec[I];
  1222.         IF P.Lim > 0 THEN
  1223.         BEGIN
  1224.            PutTxt('; ---------> Code From Line: ');
  1225.            Str(L,S);
  1226.            PutTxt(S);
  1227.            IF I = 1 THEN PutTxt('  ("BEGIN/ASM" Statement)') ELSE
  1228.            IF I = K THEN PutTxt('  ("END" Statement)');
  1229.            NewTxtLine;
  1230.            DisplayCodeLine(P);
  1231.         END;
  1232.         Inc(L); Inc(I);
  1233.         END;
  1234.      END;
  1235.      Inc(IP,P.Obj - J);
  1236.      NextLL := IP;
  1237.       END;
  1238.    END; {DisplayCode}
  1239.  
  1240.    PROCEDURE UnAssembleCode(Hash: LL;       { Owner }        {.CP38}
  1241.                   SF: Byte;    { Source Flag }
  1242.                  Org,          { Entry Point }
  1243.                Limit: LongInt; { Next Entry  }
  1244.               TrcNdx: LL;      { to Trace Entry }
  1245.              Comment: Boolean; { Explanations   }
  1246.                   MT:MapFlags);{ Type of MapRef }
  1247.    VAR Stopper : LongInt;
  1248.    BEGIN
  1249.       IF LinesRemaining < 4 THEN NewTxtPage;
  1250.       Stopper := Limit - Org;                { Byte Count }
  1251.       IF (NextLL - OffsetLL) > Org
  1252.       THEN Stopper := Limit + OffsetLL - NextLL;    { Safety Valve }
  1253.       IF Stopper > 0 THEN
  1254.       BEGIN
  1255.     IF Comment THEN {Allow Remarks}
  1256.     BEGIN
  1257.        SetCol(7); PutTxt('Code For ');
  1258.        IF SF < $05
  1259.        THEN
  1260.          IF (Hash <> $FFFF) AND (Hash <> 0)
  1261.          THEN PutTxt('PROC "'+NameOfMethod(UH,Hash)+'"')
  1262.          ELSE If MT = mfPRUI
  1263.               Then PutTxt('Unit Initialization')
  1264.                   Else PutTxt('Implementation PROC')
  1265.        ELSE
  1266.          IF (Hash <> $FFFF) AND (Hash <> 0)
  1267.          THEN PutTxt('PUBLIC "'+NameOfMethod(UH,Hash)+'"')
  1268.          ELSE PutTxt('PRIVATE or Un-named PUBLIC');
  1269.        PutTxt(' starts at '+HexA(NextLL));
  1270.        NewTxtLine;NewTxtLine;
  1271.     END;
  1272.     IF DisAssembly
  1273.     THEN DisplayCode(UH,Stopper,TrcNdx)
  1274.     ELSE Begin
  1275.       PrintCodeBytes(UC,Stopper,16,HexOff,True);
  1276.           NewTxtLine
  1277.         End;
  1278.     NewTxtLine;
  1279.       END;
  1280.    END;  {UnAssembleCode}
  1281.  
  1282.    PROCEDURE UnAssembleData(S: MapRefRec; SF: Byte);        {.CP13}
  1283.    Var SectOff: WORD;
  1284.    BEGIN
  1285.      SetCol(7);
  1286.      IF SF < $05
  1287.      THEN PutTxt('(Preamble Data Begins at ')
  1288.      ELSE PutTxt('(PRIVATE Code or Data Begins at ');
  1289.      PutTxt(HexW(NextLL)+')');
  1290.      NewTxtLine;NewTxtLine;
  1291.      SectOff := NextLL - OffsetLL;
  1292.      IF SF < $05
  1293.      THEN Begin
  1294.        PrintCodeBytes(UC,S.MapEPT-SectOff,16,HexOff,True);
  1295.        NewTxtLine End
  1296.      ELSE UnAssembleCode(S.MapOwn,SF,NextLL,OffsetLL+S.MapEPT,$FFFF,False,S.MapTyp);
  1297.      NewTxtLine;
  1298.    END;  {UnAssembleData}
  1299.  
  1300. BEGIN  {FormatObjectCode}                    {.CP55}
  1301.    IF UH^.UHCMT < UH^.UHTMT THEN  { We have Code Segments }
  1302.    BEGIN
  1303.       NoteBegin('Formatting CODE Segments');
  1304.       SaveTab := TabStop;
  1305.       TabStop := 57;
  1306.       R := AddrCodeFixUps(UH);
  1307.       UC := AddrCodeArea(UH);
  1308.       OffsetLL := Base_Code;
  1309.       PrintTitleBlk('Unit Code Group',0);
  1310.       CMaps := CountCMapSlots(UH)  *SizeOf(CMapRec);   { Code Segments }
  1311.       CXs := (CountPMapSlots(UH)-1)*SizeOf(PMapRec);
  1312.       SortProcRefs(CSegOrder);
  1313.       FetchMapRef(Map,rPROC,CXs);
  1314.       IF (Map.MapEPT = $FFFF)        { remove unused init proc    }
  1315.       THEN Dec(CXs,SizeOf(PMapRec));
  1316.       I := 0;                        { Track PMRefs Table    }
  1317.       J := 0;                        { Track CSeg Map Table    }
  1318.  
  1319.       REPEAT
  1320.          FetchMapRef(Map,rCSEG,J);        { Fetch CSeg Map Ref }
  1321.          FetchMapRef(PM,rPROC,I);        { Fetch PROC Map Ref }
  1322.      WHILE PM.MapCSM < J DO Begin        { Synchronize Maps   }
  1323.             Inc(I,SizeOf(PMapRec));
  1324.             FetchMapRef(PM,rPROC,I);
  1325.          End;
  1326.      MyOrg := Map.MapLod + Base_Code;    { Segment Load Point }
  1327.      MyEnd := MyOrg + Map.MapSiz;        { Next Segment Start }
  1328.      MyFil := Map.MapSrc;            { Segment Source Fil }
  1329.      MyTrc := AddrCMapTab(UH)^[PM.MapCSM DIV SizeOf(CMapRec)].CsegTrc;
  1330.      SP := AddrSrcTabOff(UH,MyFil);
  1331.      IF LinesRemaining < 6 THEN NewTxtPage;
  1332.      PutTxt('----  Code Map[+'+HexW(PM.MapCSM)
  1333.           +'] Segment at '+HexA(NextLL)+' Found In "');
  1334.      PutTxt(SP^.SrcName+'"');
  1335.      NewTxtLine; NewTxtLine;
  1336.      HexOff := NextLL;
  1337.      SF := SP^.SrcFlag;
  1338.      IF (PM.MapEPT + OffsetLL) > NextLL
  1339.      THEN UnAssembleData(PM,SF);
  1340.      WHILE (I <= CXs) AND (PM.MapCSM = J) DO BEGIN
  1341.          WITH PM DO
  1342.         UnAssembleCode(MapOwn,SF,MapEPT,MapEPT+MapSiz,MyTrc,True,MapTyp);
  1343.         Inc(I,SizeOf(PMapRec));
  1344.             FetchMapRef(PM,rPROC,I);
  1345.      END;
  1346.      Inc(J,SizeOf(CMapRec));
  1347.       UNTIL (J >= CMaps);
  1348.  
  1349.       TabStop := SaveTab;
  1350.       PrintTitleBlk('End Code Group',0);
  1351.       BoundaryAlign(UC);
  1352.       NoteEnd;
  1353.    END;
  1354. END; {FormatObjectCode}
  1355.  
  1356. PROCEDURE FormatDataAreas(UH : UnitPtr);            {.CP46}
  1357. VAR    PD: DMapTabPtr; SaveTab: Word; T: TypePtr;
  1358.     I, MapEnd,Base: Word; EndLL: LL; UD: Pointer; S: MapRefRec;
  1359. BEGIN
  1360.    EndLL := NextLL + UH^.UHZDT;
  1361.    IF EndLL <> NextLL THEN
  1362.    BEGIN
  1363.       NoteBegin('Formatting CONST Data Segments');
  1364.       SaveTab := TabStop;
  1365.       PrintTitleBlk('Typed CONST Data Group',5);
  1366.       WITH UH^ DO MapEnd := (UHDMT-UHTMT) DIV SizeOf(DMapRec);
  1367.       PD := AddrDMapTab(UH); UD := AddrDataArea(UH);
  1368.       OffsetLL := Base_Data;
  1369.       FOR I := 0 TO MapEnd-1 DO WITH PD^[I] DO BEGIN
  1370.      NewTxtLine;
  1371.      SetCol(7);
  1372.          FetchMapRef(S,rCONS,SizeOf(DMapRec)*I);
  1373.          PutTxt('Typed CONST''s Map[+'+HexW(I*SizeOf(DMapRec))+'] ');
  1374.      IF DSegOwn <> 0 THEN
  1375.      BEGIN
  1376.         T := TypePtr(PtrAdjust(UH,DSegOwn));
  1377.         If S.MapTyp = mfTVMT Then PutTxt('VMT Template for "')
  1378.                          Else PutTxt('DMT Template for "');
  1379.         PutTxt(AddrDict(UH,T^.ObjtName)^.DSymb+'"');
  1380.      END ELSE
  1381.          Begin
  1382.             PutTxt('From: ');
  1383.             Case S.MapTyp Of
  1384.                mfXTRN: PutTxt('Linked File');
  1385.                mfINTF: PutTxt('_INTERFACE');
  1386.                mfIMPL: PutTxt('_IMPLEMENTATION');
  1387.                mfNEST: PutTxt('PROC('+NameOfMethod(UH,S.MapOwn)+')');
  1388.                Else    PutTxt('???');
  1389.             End;
  1390.          End;
  1391.      Base := NextLL;
  1392.      SetCol(1);NewTxtLine;
  1393.      PrintCodeBytes(UD,DSegCnt,16,Base,True);
  1394.      SetCol(1);
  1395.       END; {FOR}
  1396.       PrintTitleBlk('End Typed CONST Data Group',0);
  1397.       TabStop := SaveTab;
  1398.       NoteEnd;
  1399.    END; {IF}
  1400.    BoundaryAlign(UD);
  1401. END; {FormatDataAreas}
  1402.  
  1403. PROCEDURE FixUpHeadings; Far;                    {.CP06}
  1404. BEGIN
  1405.    SetCol(7); PutTxt('Un Fl  Map  E-Adr Patch : Ptch Type Refers');
  1406.    SetCol(7); PutTxt('it ag Ofset Ofset Ofset : Size  Map To Unit');
  1407.    SetCol(7); PutTxt('-- -- ----- ----- ----- : ---- ---- --------');
  1408. END; {FixUpHeadings}
  1409.  
  1410. PROCEDURE FormatFixUpList(UH : UnitPtr);            {.CP03}
  1411. TYPE Remark = String[8]; T4 = String[4]; T8 = String[8];
  1412. Var  RB: Pointer;
  1413.  
  1414.     PROCEDURE FixUpIdentify(    R : FixUpRec;        {.CP31}
  1415.                 VAR S2, S1 : T4; VAR S3 : T8);
  1416.     VAR PU : UDonorPtr;
  1417.     BEGIN  {FixUpIdentify}
  1418.            If (R.FixFlg <> $FF) AND (R.FixDnr <> $FF) Then
  1419.            Begin
  1420.           CASE (R.FixFlg SHR 6) AND $3 OF
  1421.            0: S1 := 'PROC';    1: S1 := 'CSeg';
  1422.         2: S1 := 'DATA';    3: S1 := 'CONS';
  1423.           END;
  1424.           CASE (R.FixFlg SHR 4) AND $3 OF
  1425.            0: S2 := 'WORD';    1: S2 := 'WD+E';
  1426.         2: S2 := 'SEG ';    3: S2 := 'FPTR';
  1427.           END;
  1428.           IF (R.FixFlg AND $F) <> 0 THEN
  1429.           BEGIN S1 := '??? ';    S2 := '????';  END;
  1430.           PU := UDonorPtr(PtrAdjust(UH,UH^.UHLDU+R.FixDnr));
  1431.           S3 := PU^.UDENam;
  1432.            End Else
  1433.            Begin
  1434.           S1 := 'CSeg'; S2 := 'EM87';
  1435.               Case R.FixWd1 Of
  1436.                  2:   S3 := '(SEGSS)';
  1437.                  3:   S3 := '(SEGCS)';
  1438.                  4:   S3 := '(SEGES)';
  1439.                  5:   S3 := '';
  1440.                  6:   S3 := '(FWAIT)';
  1441.                  Else S3 := '?';
  1442.               End;
  1443.            End;
  1444.     END;   {FixUpIdentify}
  1445.  
  1446.         PROCEDURE PrintFixEntry(RR: FixUpRec);            {.CP10}
  1447.         Var S1, S2: T4; S3: T8;
  1448.         Begin
  1449.        PageOverFlow(2,FixUpHeadings);
  1450.        PrintBytes(RB,8,8);
  1451.        FixUpIdentify(RR,S1,S2,S3);
  1452.        SetCol(TabStop);   PutTxt(S1);
  1453.        SetCol(TabStop+5); PutTxt(S2);
  1454.        SetCol(TabStop+10);PutTxt(S3);
  1455.         End; {PrintFixEntry}
  1456.  
  1457. VAR  R: FixUpPtr; T: TypePtr; PU: UDonorPtr; S: MapRefRec;    {.CP43}
  1458.      RR: FixUpRecPtr; EndS, EndLL: LongInt; S1, S2: T4; S3: T8;
  1459.      I, J, K, MapEnd: Word; SaveTab: Word; OV: HeadProc;
  1460. BEGIN
  1461.    NoteBegin('Formatting Fix-Up Lists');
  1462.    SaveTab := TabStop;
  1463.    TabStop := 33;
  1464.    EndLL := NextLL + UH^.UHZFA;
  1465.    IF EndLL <> NextLL THEN WITH UH^ DO
  1466.    BEGIN
  1467.       PrintTitleBlk('Code Group Fix-Ups',7);
  1468.       SetCol(1);
  1469.       J := 0;
  1470.       RB := AddrCodeFixUps(UH);
  1471.       OffsetLL := Base_FixC;
  1472.       IF UHCMT < UHTMT THEN
  1473.       BEGIN
  1474.          MapEnd := UHTMT-UHCMT; I := 0;
  1475.      While I < MapEnd DO Begin
  1476.             FetchMapRef(Map,rCSEG,I);
  1477.         With Map Do IF MapFxJ <> 0 THEN
  1478.         BEGIN
  1479.            SetCol(1);
  1480.            IF LinesRemaining < 9 THEN NewTxtPage
  1481.                             ELSE NewTxtLine;
  1482.            SetCol(7);
  1483.            EndS := MapLod+Base_Code;
  1484.            PutTxt('Segment Load Addr = ' + HexA(EndS));
  1485.                SetCol(7);
  1486.            EndS := EndS + MapSiz;
  1487.            PutTxt('Fix-Up''s For CSeg Map Entry at ' + HexA(I + UHCMT));
  1488.            SetCol(1);NewTxtLine;
  1489.            FixUpHeadings;
  1490.                K := MapFxI;
  1491.            While K < (MapFxJ+MapFxI) DO BEGIN
  1492.                   RR := PtrAdjust(RB,K);
  1493.                   PrintFixEntry(RR^);
  1494.           Inc(K,SizeOf(FixUpRec));
  1495.            END; {While}
  1496.             End; {IF}
  1497.             Inc(I,SizeOf(CMapRec));
  1498.            END;  {While}
  1499.          PrintTitleBlk('End Code Group Fix-Ups',0);
  1500.      BoundaryAlign(RB);
  1501.       END;   { IF CSeg Map non-Empty }
  1502.                                                                     
  1503.       If UH^.UHZFT > 0 Then Begin
  1504.         PrintTitleBlk('CONST Data Group Fix-Ups',7);
  1505.       IF UHTMT < UHDMT THEN    {DSeg Map non-Empty}        {.CP56}
  1506.       BEGIN
  1507.     K := NextLL;
  1508.     MapEnd := UHDMT-UHTMT;
  1509.     EndS := 0;
  1510.         I := 0; RB := AddrDataFixUps(UH);
  1511.     OffsetLL := Base_FixD;
  1512.     With Map Do While I < MapEnd DO Begin
  1513.            FetchMapRef(Map,rCONS,I);
  1514.        IF MapFxJ <> 0 THEN
  1515.        BEGIN
  1516.           SetCol(1);
  1517.           IF LinesRemaining < 9 THEN NewTxtPage
  1518.                           ELSE NewTxtLine;
  1519.           SetCol(7);
  1520.               If MapTyp = mfTVMT
  1521.           THEN PutTxt('VMT Fix-Up''s For: '+NameOfObject(UH,MapOwn)) Else
  1522.               If MapTyp = mfTDMT
  1523.           THEN PutTxt('DMT Fix-Up''s For: '+NameOfObject(UH,MapOwn))
  1524.               Else Begin
  1525.                 PutTxt('Typed CONST Fix-Up''s for: ');
  1526.                 Case MapTyp Of
  1527.                    mfXTRN: PutTxt('Linked File');
  1528.                    mfINTF: PutTxt('_INTERFACE');
  1529.                    mfIMPL: PutTxt('_IMPLEMENTATION');
  1530.                    mfNEST: PutTxt('PROC('+NameOfMethod(UH,MapOwn)+')');
  1531.                    Else    PutTxt('???');
  1532.                 End {case}
  1533.               End;
  1534.               NewTxtLine;NewTxtLine;
  1535.               EndS := MapLod+Base_Data;
  1536.           PutTxt('Seg Load Addr = ' + HexA(EndS) + ' --');
  1537.               Inc(EndS,MapSiz);
  1538.           PutTxt(' CONST DSeg Map Entry at '+ HexW(I+UHTMT));
  1539.           SetCol(1);NewTxtLine;
  1540.           FixUpHeadings;
  1541.           K := MapFxI;
  1542.           WHILE K < (MapFxJ+MapFxI) DO BEGIN
  1543.                  RR := PtrAdjust(RB,K);
  1544.                  PrintFixEntry(RR^);
  1545.          Inc(K,SizeOf(FixUpRec));
  1546.           END; {WHILE}
  1547.        END; {If Fixups to print}
  1548.            Inc(I,SizeOf(DMapRec));
  1549.         End; {While}
  1550.       END;   { IF DSeg Map non-Empty }
  1551.       PrintTitleBlk('End CONST Data Group Fix-Ups',0);
  1552.       BoundaryAlign(UnitPtr(RB));
  1553.    END;   {IF FixUp List non-Empty}
  1554.    End;
  1555.    TabStop := SaveTab;
  1556.    NoteEnd;
  1557. END; {FormatFixUpList}
  1558.  
  1559. PROCEDURE DocumentUnit(P : UnitPtr);                {.CP17}
  1560. BEGIN
  1561.     FormatHeader(P);
  1562.     FormatDictionary(P);        { PRINT the Dictionary     }
  1563.     FormatProcMap(P);               { PRINT the PROC Map       }
  1564.     FormatCSegMap(P);               { PRINT the CSeg Map       }
  1565.     FormatTypedConMap(P);        { PRINT the CONST Map      }
  1566.     FormatGlobalVarMap(P);        { PRINT the VAR Map        }
  1567.         FormatDLLList(P);        { PRINT the DLL List       }
  1568.     FormatUnitDonorList(P);        { PRINT the Donor Unit Tab }
  1569.     FormatSourceFileList(P);    { PRINT the Source Files   }
  1570.     FormatTraceTable(P);        { PRINT the Trace Table    }
  1571.     FormatEndNonCode(P);        { PRINT separator          }
  1572.     FormatObjectCode(P);        { PRINT CODE Segments      }
  1573.     FormatDataAreas(P);        { PRINT CONST Segment Data }
  1574.     FormatFixUpList(P);        { PRINT LINKER FixUp Data  }
  1575.         PrintTitleBlk('End Unit',0);
  1576. END; {DocumentUnit}
  1577.  
  1578. VAR i,j : integer; P: UnitPtr; Module: String[8]; c: char;    {.CP63}
  1579.     K: LongInt;   NS: String[5]; 
  1580.  
  1581. BEGIN       { Main Program }
  1582.     ClrScr;
  1583.     Write('Enter Name of Unit to Document: ');ReadLn(Module);
  1584.     Write('Is Unit for WINDOWS or DOS? [W|D] ');
  1585.     i := WhereX; j := WhereY;
  1586.     REPEAT
  1587.         GoToXY(i,j);ClrEol;
  1588.         ReadLn(c);
  1589.     UNTIL UpCase(c) IN ['W','D'];
  1590.     If UpCase(c) = 'W' Then _Lib_Nam := _Win_Lib
  1591.                Else _Lib_Nam := _Dos_Lib;
  1592.     Write('Do You Want Dis-Assembly of Code? [Y|N] ');
  1593.     i := WhereX; j := WhereY;
  1594.     REPEAT
  1595.         GoToXY(i,j);ClrEol;
  1596.         ReadLn(c);
  1597.     UNTIL UpCase(c) IN ['Y','N'];
  1598.     DisAssembly := UpCase(c) = 'Y';
  1599.     i := WhereX; j := WhereY;
  1600.         IF DisAssembly Then Begin
  1601.       Write('What CPU? (0=8086,1=80186,2=80286,3=80386) ');
  1602.       i := WhereX; j := WhereY;
  1603.        REPEAT
  1604.         GoToXY(i,j);ClrEol;
  1605.         ReadLn(c);
  1606.        UNTIL c IN ['0'..'3'];
  1607.        Case C Of '0': CPUType := C086; '1': CPUType := C186;
  1608.                     '2': CPUType := C286; '3': CPUType := C386;
  1609.            End; {Case}
  1610.         End;
  1611.     FOR I := 1 TO Length(Module) DO Module[I] := UpCase(Module[I]);
  1612.     TabStop := 37;
  1613.         OffsetLL := 0;
  1614.     OpenTxt(Module+'.LST',59,80);
  1615.         NoteBegin(''); JobTime := NoteTime;
  1616.         NoteBegin('Starting Analysis of "'+Module+'"');
  1617.         Win := _Lib_Nam = _Win_Lib;
  1618.         PutTxt('Analysis of '+ Module +'.TPU');
  1619.         NewTxtLine;
  1620.         PutTxt('Assumed Compiled by TURBO PASCAL for ');
  1621.         If Win     Then PutTxt('WINDOWS (Ver. 1.0)')
  1622.         Else PutTxt('DOS (Ver. 6.0)');
  1623.         NewTxtLine;
  1624.     PutTxt('========================================='); NewTxtLine;
  1625.         P := AnalyzeUnit(Module,'');
  1626.         NoteEnd;
  1627.     IF P <> Nil THEN
  1628.     BEGIN
  1629.        PutTxt('========================================='); NewTxtLine;
  1630.        PutTxt('* Dictionary Area begins with Unit Header'); NewTxtLine;
  1631.        PutTxt('========================================='); NewTxtLine;
  1632.        NextLL := 0;
  1633.        DocumentUnit(P); NewTxtPage;
  1634.     END ELSE
  1635.         BEGIN
  1636.            WriteLn; WriteLn('Unit "',module,'" Not Found!'); WriteLn;
  1637.         End;
  1638.         PutTxt('Heap Utilization Summary');NewTxtLine;
  1639.         K := PtrDelta(HeapEnd,HeapOrg);
  1640.     Str(K/1024.0:5:1, NS);
  1641.         NewTxtLine; PutTxt(NS+' Kb Available at Start');
  1642.         K := PtrDelta(_HeapHighWaterMark,_HeapOriginalMark);
  1643.     Str(K/1024.0:5:1, NS);
  1644.         NewTxtLine; PutTxt(NS+' Kb used during Analyses');
  1645.         K := PtrDelta(HeapPtr,HeapOrg);
  1646.     Str(K/1024.0:5:1, NS);
  1647.         NewTxtLine; PutTxt(NS+' Kb in use during print');
  1648.         PurgeAllUnits;
  1649.         NewTxtLine; PutTxt('---- End Report');
  1650.         NewTxtPage;
  1651.     CloseTxt;
  1652.         NoteBegin('');
  1653.         Write('End of Job');
  1654.         NoteTime := JobTime;
  1655.         NoteEnd;
  1656.         GotoXY(NoteX,NoteY+2);
  1657. END.